home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / tcltk / tk8.4 / dialog.tcl < prev    next >
Text File  |  2009-04-29  |  7KB  |  217 lines
  1. # dialog.tcl --
  2. #
  3. # This file defines the procedure tk_dialog, which creates a dialog
  4. # box containing a bitmap, a message, and one or more buttons.
  5. #
  6. # RCS: @(#) $Id: dialog.tcl,v 1.14.2.5 2007/05/30 06:37:03 das Exp $
  7. #
  8. # Copyright (c) 1992-1993 The Regents of the University of California.
  9. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #
  16. # ::tk_dialog:
  17. #
  18. # This procedure displays a dialog box, waits for a button in the dialog
  19. # to be invoked, then returns the index of the selected button.  If the
  20. # dialog somehow gets destroyed, -1 is returned.
  21. #
  22. # Arguments:
  23. # w -        Window to use for dialog top-level.
  24. # title -    Title to display in dialog's decorative frame.
  25. # text -    Message to display in dialog.
  26. # bitmap -    Bitmap to display in dialog (empty string means none).
  27. # default -    Index of button that is to display the default ring
  28. #        (-1 means none).
  29. # args -    One or more strings to display in buttons across the
  30. #        bottom of the dialog box.
  31.  
  32. proc ::tk_dialog {w title text bitmap default args} {
  33.     global tcl_platform
  34.     variable ::tk::Priv
  35.  
  36.     # Check that $default was properly given
  37.     if {[string is integer -strict $default]} {
  38.     if {$default >= [llength $args]} {
  39.         return -code error "default button index greater than number of\
  40.             buttons specified for tk_dialog"
  41.     }
  42.       # Never call if -strict option is omitted in previous test !
  43.     } elseif {"" eq $default} {
  44.     set default -1
  45.     } else {
  46.     set default [lsearch -exact $args $default]
  47.     }
  48.  
  49.     set windowingsystem [tk windowingsystem]
  50.     if {$tcl_platform(platform) eq "macintosh" || $windowingsystem eq "aqua"} {
  51.     option add *Dialog*background systemDialogBackgroundActive widgetDefault
  52.     option add *Dialog*Button.highlightBackground \
  53.         systemDialogBackgroundActive widgetDefault
  54.     }
  55.  
  56.     # 1. Create the top-level window and divide it into top
  57.     # and bottom parts.
  58.  
  59.     destroy $w
  60.     toplevel $w -class Dialog
  61.     wm title $w $title
  62.     wm iconname $w Dialog
  63.     wm protocol $w WM_DELETE_WINDOW { }
  64.  
  65.     # Dialog boxes should be transient with respect to their parent,
  66.     # so that they will always stay on top of their parent window.  However,
  67.     # some window managers will create the window as withdrawn if the parent
  68.     # window is withdrawn or iconified.  Combined with the grab we put on the
  69.     # window, this can hang the entire application.  Therefore we only make
  70.     # the dialog transient if the parent is viewable.
  71.     #
  72.     if {[winfo viewable [winfo toplevel [winfo parent $w]]] } {
  73.     wm transient $w [winfo toplevel [winfo parent $w]]
  74.     }
  75.  
  76.     if {$tcl_platform(platform) eq "macintosh" || $windowingsystem eq "aqua"} {
  77.     ::tk::unsupported::MacWindowStyle style $w moveableModal {}
  78.     }
  79.  
  80.     frame $w.bot
  81.     frame $w.top
  82.     if {$windowingsystem eq "x11"} {
  83.     $w.bot configure -relief raised -bd 1
  84.     $w.top configure -relief raised -bd 1
  85.     }
  86.     pack $w.bot -side bottom -fill both
  87.     pack $w.top -side top -fill both -expand 1
  88.  
  89.     # 2. Fill the top part with bitmap and message (use the option
  90.     # database for -wraplength and -font so that they can be
  91.     # overridden by the caller).
  92.  
  93.     option add *Dialog.msg.wrapLength 3i widgetDefault
  94.     if {$tcl_platform(platform) eq "macintosh" || $windowingsystem eq "aqua"} {
  95.     option add *Dialog.msg.font system widgetDefault
  96.     } else {
  97.     option add *Dialog.msg.font {Times 12} widgetDefault
  98.     }
  99.  
  100.     label $w.msg -justify left -text $text
  101.     pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
  102.     if {$bitmap ne ""} {
  103.     if {($tcl_platform(platform) eq "macintosh"
  104.          || $windowingsystem eq "aqua") && ($bitmap eq "error")} {
  105.         set bitmap "stop"
  106.     }
  107.     label $w.bitmap -bitmap $bitmap
  108.     pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
  109.     }
  110.  
  111.     # 3. Create a row of buttons at the bottom of the dialog.
  112.  
  113.     set i 0
  114.     foreach but $args {
  115.     button $w.button$i -text $but -command [list set ::tk::Priv(button) $i]
  116.     if {$i == $default} {
  117.         $w.button$i configure -default active
  118.     } else {
  119.         $w.button$i configure -default normal
  120.     }
  121.     grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew \
  122.         -padx 10 -pady 4
  123.     grid columnconfigure $w.bot $i
  124.     # We boost the size of some Mac buttons for l&f
  125.     if {$tcl_platform(platform) eq "macintosh" || $windowingsystem eq "aqua"} {
  126.         set tmp [string tolower $but]
  127.         if {$tmp eq "ok" || $tmp eq "cancel"} {
  128.         grid columnconfigure $w.bot $i -minsize 90
  129.         }
  130.         grid configure $w.button$i -pady 7
  131.     }
  132.     incr i
  133.     }
  134.  
  135.     # 4. Create a binding for <Return> on the dialog if there is a
  136.     # default button.
  137.  
  138.     if {$default >= 0} {
  139.     bind $w <Return> "
  140.     [list $w.button$default] configure -state active -relief sunken
  141.     update idletasks
  142.     after 100
  143.     set ::tk::Priv(button) $default
  144.     "
  145.     }
  146.  
  147.     # 5. Create a <Destroy> binding for the window that sets the
  148.     # button variable to -1;  this is needed in case something happens
  149.     # that destroys the window, such as its parent window being destroyed.
  150.  
  151.     bind $w <Destroy> {set ::tk::Priv(button) -1}
  152.  
  153.     # 6. Withdraw the window, then update all the geometry information
  154.     # so we know how big it wants to be, then center the window in the
  155.     # display and de-iconify it.
  156.  
  157.     wm withdraw $w
  158.     update idletasks
  159.     set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
  160.         - [winfo vrootx [winfo parent $w]]}]
  161.     set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
  162.         - [winfo vrooty [winfo parent $w]]}]
  163.     # Make sure that the window is on the screen and set the maximum
  164.     # size of the window is the size of the screen.  That'll let things
  165.     # fail fairly gracefully when very large messages are used. [Bug 827535]
  166.     if {$x < 0} {
  167.     set x 0
  168.     }
  169.     if {$y < 0} {
  170.     set y 0
  171.     }
  172.     wm maxsize $w [winfo screenwidth $w] [winfo screenheight $w]
  173.     wm geometry $w +$x+$y
  174.     wm deiconify $w
  175.  
  176.     tkwait visibility $w
  177.  
  178.     # 7. Set a grab and claim the focus too.
  179.  
  180.     set oldFocus [focus]
  181.     set oldGrab [grab current $w]
  182.     if {$oldGrab ne ""} {
  183.     set grabStatus [grab status $oldGrab]
  184.     }
  185.     grab $w
  186.     if {$default >= 0} {
  187.     focus $w.button$default
  188.     } else {
  189.     focus $w
  190.     }
  191.  
  192.     # 8. Wait for the user to respond, then restore the focus and
  193.     # return the index of the selected button.  Restore the focus
  194.     # before deleting the window, since otherwise the window manager
  195.     # may take the focus away so we can't redirect it.  Finally,
  196.     # restore any grab that was in effect.
  197.  
  198.     vwait ::tk::Priv(button)
  199.     catch {focus $oldFocus}
  200.     catch {
  201.     # It's possible that the window has already been destroyed,
  202.     # hence this "catch".  Delete the Destroy handler so that
  203.     # Priv(button) doesn't get reset by it.
  204.  
  205.     bind $w <Destroy> {}
  206.     destroy $w
  207.     }
  208.     if {$oldGrab ne ""} {
  209.     if {$grabStatus ne "global"} {
  210.         grab $oldGrab
  211.     } else {
  212.         grab -global $oldGrab
  213.     }
  214.     }
  215.     return $Priv(button)
  216. }
  217.